perm filename STUFF.F4[NEW,LCS] blob sn#148555 filedate 1975-03-03 generic text, type T, neo UTF8
29500	C******  MVBEAM, MVBX, RTLINE, EXTEN, CLEFS, TYPX
29600		FUNCTION RTLINE(L)
29700		COMMON R2,JA,CENTR,J2,RJQ(20),JQ(20)/XRN/RN(4000)
29800		RTLINE=-1
29900		IF(R2.GT.4)GO TO 1
29910		IF(RN(L+2).NE.R2)RETURN
29920	1	RTLINE=0
30000		END
30100	
30200		FUNCTION EXTEN(X)
30300		EXTEN=AMOD(X,1.)*10.
30400		END
30500	
30550	C  THESE MOVE ENDS OF PARTIAL INNER BEAMS.
30600		SUBROUTINE MVBEAM(R,I,JY,L,W)
30650	C  L AND JY ARE FOR MOVES TO DIFF. STAFF.
30700		DIMENSION R(1)
30710		Y=R(JY+I)
30720		Z=ABS(Y)
30730		IF(Z.LT.100.)GO TO 1
30740	C  NEXT FOR MINIS, DIAMONDS, 'X' NOTES. (LIMIT OF +-99 ON ALTITUDE.)
30750		Y=AMOD(Y,100.)
30755		X=Y+W
30760		Z=Z-ABS(Y)+ABS(X)
30770	C  PUTS ALL INTO POSITIVE
30780		IF(X)Z=-Z
30790		GO TO 2
30795	1	Z=Y+W
30800	2	R(L+I)=Z
30900		END
31000	
31100		SUBROUTINE MVBX(I)
31110	      COMMON R2,JA,CENTR,J2,RJQ(20),L,RDIS,JQ(18)/KJY/K,JY/XRN/R(4000)
31210		EQUIVALENCE (R4,RJQ(2)),(R8,RJQ(6))
31300		R(L+I)=R8+(R(JY+I)-R4)*RDIS
31400		END
31500	
31600		SUBROUTINE CLEFS
31700	      DIMENSION JCLEF(11),MCLEF(700),RCMIN(4),KCLEF(11),NCLEF(350),CM(4)
31800		COMMON /STF/RSTFAC(8),RSTJ2 /PLTR/IPLT,RHT,DIS
31900		COMMON R2,JA,CENTR,J2,RJQ(20),JQ(20)
32000	      DATA RCMIN/3.3,10.5,7.0,10.5/,CM/.1,1.5,1.1,1.5/
32100		EQUIVALENCE (R4,RJQ(2)),(J5,JQ(3)),(J9,JQ(7)),(KK,
32200	     1 KCLEF(11)),(R6,RJQ(4)),(R5,RJQ(3)),(R8,RJQ(6)),(R7,RJQ(5))
32300		1,(R9,RJQ(7)),(NJR,RJQ(8)),(K,JCLEF(11)),(NCLEF,MCLEF(351))
32350		1,(R3,RJQ(1))
32400		J5=MOD(J5,100)
32600		CALL NOZERO(R6)
32700		IF(R7.EQ.0)R7=R6
32800	C  IF P7 = 0, IT WILL EQUAL P6.
32900		IF(JA.GT.10)GO TO 9
33000		NAME='CLEF0'
33100		IF(J5.LT.20)GO TO 4
33200		R6=R6*.3
33300	C  SIZE FACTORS FOR SPECIAL WORDS, ETC. (PPP, MF, CRESC. ETC.)
33400		R7=R7*.3
33500		GO TO 4
33600	9	IF(NAME.EQ.NJR)GO TO 4
33700		IF(NAME.EQ.0)GO TO 177
33710		IF(NJR.EQ.0)GO TO 4
33800	177	IF(NJR.EQ.0)GO TO 8	
33900	C  TO PICK UP BASIC DRAW NAME FROM P10 
34000		NAME=NJR
34100		GO TO 4
34200	8	TYPE 5
34300	5	FORMAT(' SET P10=1'/)
34400	C  LEADS TO PROPER FILE CALL
34500	4	NM=NAME+2*(J5/10)
34600	C  DRAW0 HAS ITEMS 0→9;  DRAW1, 10→19; ETC. TO DRAW9, 90→99
34700		JEZ=MOD(J5,10)+1
34800	2	IF(NM.EQ.JNM)GO TO 30
34810		IF(NM.EQ.KNM)GO TO 30
34900	C  SET P10≠0 TO CHANGE BASIC 'DRAW' NAME.
35000	C  JUMP IF ALREADY IN CORE
35100		IF(LOOKF(NM))GO TO 1111
35200		TYPE 1112,NM
35300		RETURN
35400	1112	FORMAT(1XA5,' -- NOT FOUND')
35500	1111	CALL GETFI2(NM)
35600		IF(KX)GO TO 33
35700		KX=-1
35800		JNM=NM
36200		CALL FASTI2(JCLEF,11)
36300		CALL FASTI2(MCLEF,K)
36400	C  NEW DATA READER  6/74 -- 10/74 HOLDS 2 .DMD FILES IF THEY FIT.
36500		IF(K.LE.350)GO TO 30
36600		KX=0
36700		KNM=0
36800		GO TO 30
36900	33	CALL FASTI2(KCLEF,11)
37000		KX=0
37100		IF(KK.GT.350)GO TO 1111
37200	C  JUMP BACK IF IT WON'T FIT.
37300		CALL FASTI2(NCLEF,KK)
37400		KNM=NM
37600	C   CHECK THE ABOVE  -- FOR P5 HEIGHT CHANGE *********************
37700	C  R6 IS SIZE FACTOR
37800	30	IF(J5.GT.3)GO TO 811
37810		IF(JA.NE.3)GO TO 811
37900	C  0=TREB, 1=BASS, 2=ALTO, 3=TENOR(ALTO SHIFTED UP)
38100	C  ↑↑↑↑↑↑↑↑  FIXUP SOMEDAY IN .DMD FILES
38200		IF(R5.LT.100)GO TO 812
38300		RSTJ2=.8*RSTJ2
38500	C  TO SET HGT. OF MINI CLEFS
38510		R4=R4+CM(JEZ)
38520	C  SHIFTS MINIS UP BECAUSE OF WRONG ORIG. POS.??
38600	812	IF(JEZ.NE.4)GO TO 811
38800		R4=R4+2
38900		JEZ=3
39000	C   ABOVE IS NOW AT TOP
39100	
39200	811	A=R4
39300		R4=A+2.9
39400		CALL CENTX
39500		R4=A
39600	
39800		L=JCLEF(JEZ)
39900		IF(NM.EQ.KNM)L=KCLEF(JEZ)+350
40000		IF(J9.EQ.0)GO TO 31
40100		CALL ROTATE(MCLEF,L)
40200	C  R9=P9=DEGREES OF ROTATION (0-360)
40300		IF(KK.GT.250)KX=0
40400	C CHECK TO SEE IF DATA WAS WIPED OUT.
40500	31	IF(R8.EQ.-2)GO TO 32
40505		IF(IPLT)GO TO 77
40510		IF(R8.NE.-1)GO TO 32
40600	C			R8=-2 OMITS FILLER DURING PLOT
40700	77	DO 3 K=L+1,MCLEF(L)+L
40800		IF(MCLEF(K).LT.200000000)GO TO 3
40900		JEZ=MCLEF(L)-1
41000		IF(K.GT.L+1)JEZ=JEZ-K+L+1
41100		CALL FILLMS(JEZ,MCLEF(K),R3,CENTR,R6,R7)
41105		GO TO 32
41110	3	CONTINUE
41155	C  FILLS ONLY WHEN PLOTING OR R8=-1
41200	32	CALL JDRAW(MCLEF(L),R3,CENTR,RSTJ2,R6,R7)
41300	C   3,POS.,STF,NT# OR CLEF,ITEM#,SIZEX,SIZEY, R8=-1 TO FILL ON CRT
41400	
41800		END
41900	
42000		SUBROUTINE TYPX(R)
42100		COMMON/FRMT/F78F(1),FA1(1),FA5(1)
42200		TYPE F78F,R
42300		END